perm filename EAUX2C.2[EAL,HE]3 blob
sn#704697 filedate 1983-04-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Editor: Aux display routines }
C00031 00003 { Externally defined routines from elsewhere: }
C00033 00004 (* debugging routines: setECurInt *)
C00035 00005 (* displayLines routine *)
C00044 00006 (* routines to shift display: deleteLines, insertLines *)
C00057 ENDMK
C⊗;
{$NOMAIN Editor: Aux display routines }
(* definition of record types & global variables used by AL *)
const
maxLines = 28;
maxPPLines = 12;
maxBpts = 25;
maxTBpts = 20; (* max could be exceeded by huge case stmnt *)
listinglength = 2000; (* Length of Listingarray *)
type
(* random type declarations for OMSI/SAIL compatibility *)
ascii = char;
atext = text;
byte = 0..255;
(* Here are all the pointer-type definitions. Since the various *)
(* records reference each other so much, we have to put them all here. *)
vectorp = ↑vector;
transp = ↑trans;
strngp = ↑strng;
eventp = ↑event;
framep = ↑frame;
statementp = ↑statement;
varidefp = ↑varidef;
nodep = ↑node;
identp = ↑ident;
tokenp = ↑token;
reswordp = ↑resword;
pdbp = ↑pdb;
envheaderp = ↑envheader;
enventryp = ↑enventry;
environp = ↑environment;
cmoncbp = ↑cmoncb;
messagep = ↑message;
linerecp = ↑linerec;
(* datatype definitions *)
datatypes = (pconstype, varitype, svaltype, vectype, rottype, transtype,
frametype, eventtype, strngtype, labeltype, proctype, arraytype,
reftype, valtype, cmontype, nulltype, undeftype,
dimensiontype, mactype, macargtype, freevartype);
scalar = real;
vector = record refcnt: integer; val: array [1..3] of real end;
trans = record refcnt: integer; val: array [1..3,1..4] of real end;
cstring = packed array [1..10] of ascii;
c4str = packed array [1..4] of ascii;
c5str = packed array [1..5] of ascii;
c20str = packed array [1..20] of ascii;
linestr = packed array [1..130] of ascii;
strng = record
next: strngp;
ch: cstring;
end;
event = record
next: eventp; (* all events are on one big list *)
count: integer;
waitlist: pdbp;
end;
frame = record
vari: varidefp; (* back pointer to variable name & info *)
calcs: nodep; (* affixment info *)
case ftype: boolean of (* frame = true, device = false *)
true: (valid: integer; val, fdepr: transp; dcntr: integer; dev: framep);
false: (mech: integer; case sdev: boolean of
true: (sdest: real); false: (tdest,appr,depr: transp));
(* sdev = true for scalar devices, false for frames *)
end;
(* statement definitions *)
stmntypes = (progtype, blocktype, coblocktype, endtype, coendtype,
fortype, iftype, whiletype, untiltype, casetype,
calltype, returntype,
printtype, prompttype, pausetype, aborttype, assigntype,
signaltype, waittype, enabletype, disabletype, cmtype,
affixtype, unfixtype,
movetype,jtmovetype,operatetype,opentype,closetype,centertype,
floattype, stoptype, retrytype,
requiretype, definetype, macrotype, commenttype, dimdeftype,
setbasetype, wristtype, saytype, declaretype, emptytype,
evaltype, armmagictype);
(* more??? *)
statement = packed record
next, last: statementp;
stlab: varidefp;
exprs: nodep; (* any expressions used by this statement *)
nlines: integer;
bpt,bad: boolean;
case stype: stmntypes of
progtype: (pcode: statementp; errors: integer);
blocktype,
declaretype,
endtype,
coendtype: (bcode, bparent: statementp; blkid: identp;
level, numvars: 0..255; variables: varidefp);
coblocktype: (threads: nodep; nthreads: integer; cblkid: identp);
cmtype: (oncond: nodep; conclusion: statementp;
deferCm, exprCm: boolean; cdef: varidefp);
end;
(* auxiliary definitions: variable, etc. *)
varidef = packed record
next,dnext: varidefp;
name: identp;
level: 0..255; (* environment level *)
offset: 0..255; (* environment offset *)
dtype: varidefp; (* to hold the dimension info *)
tbits: 0..15; (* special type bits: array = 1, proc = 2, ref = 4 & ? *)
dbits: 0..15; (* for use by debugger/interpreter *)
case vtype: datatypes of
arraytype: (a: nodep);
proctype: (p: nodep);
labeltype,
cmontype: (s: statementp);
mactype: (mdef: statementp);
macargtype: (marg: tokenp);
pconstype: (c: nodep);
dimensiontype: (dim: nodep);
end;
(* definition of the ubiquitous NODE record *)
nodetypes = (exprnode, leafnode, listnode, clistnode, colistnode, forvalnode,
deprnode, viaptnode, apprnode, destnode, byptnode, durnode,
sfacnode, wobblenode, swtnode, nullingnode, wristnode, cwnode,
arrivalnode, departingnode,
ffnode, forcenode, stiffnode, gathernode, cmonnode, errornode,
calcnode, arraydefnode, bnddefnode, bndvalnode,
waitlistnode, procdefnode, tlistnode, dimnode, commentnode,
linearnode, elbownode, shouldernode, flipnode, wrtnode,
loadnode,velocitynode);
exprtypes = ( svalop, (* scalar operators *)
sltop, sleop, seqop, sgeop, sgtop, sneop, (* relations *)
notop, orop, xorop, andop, eqvop, (* logical *)
saddop, ssubop, smulop, sdivop, snegop, sabsop, (* scalar ops *)
sexpop, maxop, minop, intop, idivop, modop,
sqrtop, logop, expop, timeop, (* functions *)
sinop, cosop, tanop, asinop, acosop, atan2op, (* trig *)
vdotop, vmagnop, tmagnop,
vecop, (* vector operators *)
vmakeop, unitvop, vaddop, vsubop, crossvop, vnegop,
svmulop, vsmulop, vsdivop, tvmulop, wrtop,
tposop, taxisop,
transop, (* trans operators *)
tmakeop, torientop, ttmulop, tvaddop, tvsubop, tinvrtop,
vsaxwrop, constrop, ftofop, deproachop, fmakeop, vmkfrcop,
ioop, (* i/o operators *)
queryop, inscalarop,
specop, (* special operators *)
arefop, callop, grinchop, macroop, vmop, adcop, dacop, jointop,
badop,
addop, subop, negop, mulop, divop, absop); (* for parsing *)
leaftypes = pconstype..strngtype;
reltypes = sltop..sgtop;
forcetypes = (force,absforce,torque,abstorque,angvelocity);
node = record
next: nodep;
case ntype: nodetypes of
exprnode: (op: exprtypes; arg1, arg2, arg3: nodep; elength: integer);
leafnode: (case ltype: leaftypes of
varitype: (vari: varidefp; vid: identp);
pconstype: (cname: varidefp; pcval: nodep);
svaltype: (s: scalar; wid: integer);
vectype: (v: vectorp);
transtype: (t: transp);
strngtype: (length: integer; str: strngp) ); (* also used by commentnodes *)
listnode: (lval: nodep);
clistnode: (cval: integer; stmnt: statementp; clast: nodep);
colistnode: (prev: nodep; cstmnt: statementp);
cmonnode: (cmon: statementp; errhandlerp: boolean);
procdefnode:(ptype: datatypes; level: 0..255;
pname, paramlist: varidefp; body: statementp);
end;
(* records for parser: ident, token, resword *)
ident = record
next: identp;
length: integer;
name: strngp;
predefined: varidefp;
end;
tokentypes = (reswdtype, identtype, constype, comnttype, delimtype, labeldeftype,
macpartype);
constypes = svaltype..strngtype;
reswdtypes = (stmnttype, filtype, clsetype, decltype, optype, edittype);
filtypes = (abouttype,alongtype,attype,bytype,defertype,dotype,elsetype,
errmodestype,fromtype,handtype,intype,nonrigidlytype,rigidlytype,
sourcefiletype,steptype,thentype,totype,untltype,viatype,
withtype,worldtype,zeroedtype,oftype,wheretype,nowaittype,
ontype,offtype,ppsizetype,collecttype,alltype,lextype,
notype,righttype,lefttype,uptype,downtype,motiontype);
clsetypes = (approachtype,arrivaltype,departuretype,departingtype,durationtype,
errortype,forcetype,forceframetype,forcewristtype,gathertype,
nildeproachtype,nullingtype,stiffnesstype,
torquetype,velocitytype,wobbletype,
cwtype,ccwtype,stopwaittimetype,angularvelocitytype,
respecttype,elbowtype,shouldertype,fliptype,lineartype,
jointspacetype,loadtype);
edittypes = (getcmd,savecmd,insertcmd,renamecmd,startcmd,gocmd,proceedcmd,
stepcmd,sstepcmd,nstepcmd,gstepcmd,executecmd,setcmd,tracecmd,
breakcmd,unbreakcmd,tbreakcmd,definecmd,markcmd,unmarkcmd,
popcmd,atcmd,calibratecmd);
token = record
next: tokenp;
case ttype: tokentypes of
constype: (cons: nodep);
comnttype: (len: integer; str: strngp);
delimtype: (ch: ascii);
reswdtype: (case rtype: reswdtypes of
stmnttype: (stmnt: stmntypes);
filtype: (filler: filtypes);
clsetype: (clause: clsetypes);
decltype: (decl: datatypes);
optype: (op: exprtypes);
edittype: (ed: edittypes) );
identtype: (id: identp);
labeldeftype: (lab: varidefp);
macpartype: (mpar: varidefp);
end;
resword = record
next: reswordp;
length: integer;
name: strngp;
case rtype: reswdtypes of
stmnttype: (stmnt: stmntypes);
filtype: (filler: filtypes);
clsetype: (clause: clsetypes);
decltype: (decl: datatypes);
optype: (op: exprtypes);
edittype: (ed: edittypes);
end;
(* process descriptor blocks & environment record definitions *)
queuetypes = (nullqueue,nowrunning,runqueue,inputqueue,eventqueue,sleepqueue,
forcewait,devicewait,joinwait,proccall);
pdb = packed record
nextpdb,next: pdbp; (* for list of all/active pdb's *)
level: 0..255; (* lexical level *)
mode: 0..255; (* expression/statement/sub-statement *)
priority: 0..255; (* probably never greater than 3? *)
status: queuetypes; (* what are we doing *)
env: envheaderp;
spc: statementp; (* current statement *)
epc: nodep; (* current expression (if any) *)
sp: nodep; (* intermediate value stack *)
cm: cmoncbp; (* if we're a cmon point to our definition *)
mech: framep; (* current device being used *)
linenum: integer; (* used by editor/debugger *)
case procp: boolean of (* true if we're a procedure *)
true: (opdb: pdbp; (* pdb to restore when procedure exits *)
pdef: nodep); (* procedure definition node *)
false: (evt: eventp; (* event to signal when process goes away *)
sdef: statementp); (* first statement where process was defined *)
end;
envheader = packed record
parent: envheaderp;
env: array [0..4] of environp;
varcnt: 0..255; (* # of variables in use ??? *)
case procp: boolean of (* true if we're a procedure *)
true: (proc: nodep);
false:(block: statementp);
end;
enventry = record
case etype: datatypes of
svaltype: (s: scalar);
vectype: (v: vectorp);
transtype: (t: transp);
frametype: (f: framep);
eventtype: (evt: eventp);
strngtype: (length: integer; str: strngp);
cmontype: (c: cmoncbp);
proctype: (p: nodep; penv: envheaderp);
reftype: (r: enventryp);
arraytype: (a: envheaderp; bnds: nodep);
end;
environment = record
next: environp;
vals: array [0..9] of enventryp;
end;
cmoncb = record
running, enabled: boolean; (* cmon's status *)
cmon: statementp;
pdb: pdbp;
evt: eventp;
fbits: integer; (* bits for force sensing *)
oldcmon: cmoncbp; (* for debugger *)
end;
(* definition of AL-ARM messages *)
msgtypes = (initarmscmd,calibcmd,killarmscmd,wherecmd,
abortcmd,stopcmd,movehdrcmd,movesegcmd,
centercmd,operatecmd,movedonecmd,signalcmd,
setccmd,forcesigcmd,forceoffcmd,biasoncmd,biasoffcmd,setstiffcmd,
zerowristcmd,wristcmd,gathercmd,getgathercmd,readadccmd,writedaccmd,
errorcmd,floatcmd,setloadcmd,
armmagiccmd,realcmd,vectorcmd,transcmd);
errortypes = (noerror,noarmsol,timerr,durerr,toolong,featna,
unkmess,srvdead,adcdead,nozind,exjtfc,paslim,nopower,badpot,devbusy,
baddev,timout,panicb,nocart,cbound,badparm);
message = record
cmd: msgtypes;
ok: boolean;
case integer of
1: (dev, bits, n: integer;
(* (dev, bits, n, evt: integer; (* for arm code version *)
evt: eventp;
dur: real;
case integer of
1: (v1,v2,v3: real);
2: (sfac,wobble,pos: real);
3: (val,angle,mag: real);
4: (max,min: real);
5: (error: errortypes));
2: (fv1,fv2,fv3,mv1,mv2,mv3: real); (* may never use these... *)
3: (t: array [1..6] of real);
end;
interr = record
case integer of
0: (i: integer);
1: (err,foo: errortypes);
end;
(* print related records: *)
cursorp = record
cline,ind: integer;
case stmntp: boolean of
true: (st: statementp);
false: (nd: nodep);
end;
linerec = record
next: linerecp;
start,length: integer
end;
listingarray = packed array [0..listinglength] of ascii;
(* global variables *)
var
(* from EDIT *)
listing: listingarray; (* first 150 chars are used by expression editor *)
(* next 40 by header & trailer lines *)
{*} cursorStack: array [1..15] of cursorp; {These are BIG records! }
lbuf: array [1..160] of ascii;
ppBuf: array [1..100] of ascii;
lines: array [1..maxLines] of linerecp; (* what's on the screen + some *)
ppLines: array [1..maxPPLines] of linerecp; (* for page printer *)
marks: array [1..20] of integer;
reswords: array [0..26] of reswordp;
idents: array [0..26] of identp;
macrostack: array [1..10] of tokenp;
curmacstack: array [1..10] of varidefp;
screenheight,dispHeight: integer;
ppBufp,oppBufp,ppOffset,ppSize,nmarks: integer;
lbufp,cursor,ocur,cursorLine,fieldnum,lineNum,findLine,pcLine: integer;
firstDline,topDline,botDline,firstLine,lastLine,curLine: integer;
freeLines,oldLines: linerecp;
sysVars: varidefp;
dProg: statementp;
curBlock, newDeclarations, findStmnt: statementp;
macrodepth: integer;
filedepth, errCount, sCursor: integer;
curChar, maxChar, curFLine, curPage: integer;
nodim, distancedim, timedim, angledim,
forcedim, torquedim, veldim, angveldim: varidefp;
fvstiffdim, mvstiffdim: nodep;
pnode: nodep;
smartTerminal: boolean; (* true = insert/delete, false = redraw line *)
setUp,setExpr,setCursor,dontPrint,outFilep,collect,fParse,sParse,
eofError,endOfLine,backup,expandmacros,flushcomments,checkDims,
shownLine: boolean;
curtoken: token;
file1,file2,file3,file4,file5,outFile: atext;
bpts: array [1..maxBpts] of statementp; (* debugging crap *)
tbpts: array [1..maxTBpts] of statementp;
debugPdbs: array [0..10] of pdbp;
nbpts,ntbpts,debugLevel: integer;
eCurInt: pdbp;
STLevel: integer; (* set by GO *)
singleThreadMode,tSingleThreadMode: boolean;
(* from INTERP *)
inputLine: array [1..20] of ascii;
talk: text; (* for using the speech synthesizer *)
curInt, activeInts, readQueue, allPdbs: pdbp;
sysEnv: envheaderp;
clkQueue: nodep;
allEvents: eventp;
etime: integer; (* used by eval *)
curtime: integer; (* who knows where this will get updated - an ast? *)
stime: integer; (* used for clock queue on 10 *)
msg: messagep; (* for AL-ARM interaction *)
inputp: integer; (* current offset into inputLine array above *)
resched, running, escapeI, iSingleThreadMode: boolean;
msgp: boolean; (* flag set if any messages pending *)
inputReady: boolean;
(* various constant pointers *)
xhat,yhat,zhat,nilvect: vectorp;
niltrans: transp;
gpark, rpark: transp; (* arm park positions *)
(* various device & variable pointers *)
speedfactor: enventryp;
garm: framep;
{ Externally defined routines from elsewhere: }
(* From EROOT *)
procedure e2cputstmnt(s: statementp; indent, plevel: integer); external;
(* From EAUX1A *)
procedure out1Line(line,start,length: integer); external;
procedure clearLine(i: integer); external;
procedure pushStmnt(s: statementp; indent: integer); external;
procedure borderLines; external;
(* From PP *)
procedure relLine(l: linerecp); external;
(* From DISP *)
procedure showCursor(line,col: integer); external;
procedure insLine(line,num: integer); external;
procedure delLine(line,num: integer); external;
procedure eAux2cGet; external;
procedure eAux2cGet; begin end;
(* debugging routines: setECurInt *)
procedure setECurInt; external;
procedure setECurInt;
var i,j: integer;
procedure thisPdb(p: pdbp);
begin
with cursorStack[i] do
repeat
with p↑ do
if (priority div 10) = j then (* only look at one level at a time *)
if stmntp and (not procp) then
begin
if cm <> nil then
begin
if (st↑.stype = cmtype) and (st = cm↑.cmon) then eCurInt := p;
end
else if st = sdef then eCurInt := p
end
else if (nd↑.ntype = procdefnode) and procp then
if nd = pdef then eCurInt := p;
p := p↑.nextpdb;
until (eCurInt <> nil) or (p = nil);
end;
begin
eCurInt := nil;
j := debugLevel;
repeat
i := cursor;
repeat
if j > 0 then thisPdb(debugPdbs[j]);
if (eCurInt = nil) then thisPdb(allPdbs);
i := i - 1;
until (eCurInt <> nil) or (i = 0);
j := j - 1;
until (eCurInt <> nil) or (j < 0);
if eCurInt = nil then eCurInt := debugPdbs[0];
end;
(* displayLines routine *)
procedure displayLines(var pfrom: integer); external;
procedure displayLines;
var pto,oldDline,i,j,k: integer;
begin
if pfrom < 1 then pfrom := 1
else if pfrom+dispHeight > dprog↑.nlines then
begin
if dprog↑.nlines > dispHeight then pfrom := dprog↑.nlines-dispHeight+1
else pfrom := 1;
end;
pto := pfrom + dispHeight - 1;
if pto > dprog↑.nlines then pto := dprog↑.nlines;
if (cursorLine < pfrom) or (pto < cursorLine) then
begin (* need to move cursor *)
if cursorLine < pfrom then cursorLine := pfrom else cursorLine := pto;
setCursor := true;
end;
oldDline := firstDline; (* remember where current display starts *)
if (topDline <= pfrom) and (pfrom <= botDline) then (* roll up *)
begin
firstDline := pfrom - topDline + 1; (* new first displayed line *)
j := firstDline - oldDline; (* # & direction of lines to scroll *)
if pto <= botDline then
begin (* just need to adjust which lines we're showing *)
if smartTerminal then
begin
if abs(j) >= dispHeight then
for i := 1 to dispHeight do (* redraw them *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length)
else if j < 0 then
begin (* scroll down *)
j := -j;
delLine(dispHeight-j+1,j); (* delete last j lines *)
insLine(1,j); (* insert j new lines at top *)
for i := 1 to j do (* redraw them *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
end
else if j > 0 then
begin (* scroll up *)
delLine(1,j); (* delete first j lines *)
insLine(dispHeight-j+1,j); (* insert j new lines at bottom *)
for i := dispHeight-j+1 to dispHeight do (* redraw them *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
end
end
else
if firstDline <> oldDline then (* really anything to do? *)
for j := firstDline to firstDline + dispHeight - 1 do (* redraw screen *)
with lines[j]↑ do
out1Line(j-firstDline+1,start,length);
firstLine := 0;
lastLine := -1; (* so we won't invoke putStmnt below *)
end
else
begin (* scroll up & add new bottom lines *)
k := pto - topDline + 1 - maxLines; (* # of lines needed *)
if k > 0 then (* do we have enough? *)
begin (* make room in lines list for new lines *)
for i := 1 to k do relLine(lines[i]); (* flush old lines *)
for i := 1 to maxLines-k do lines[i] := lines[i+k]; (* shift up others *)
for i := maxLines+1-k to maxLines do lines[i] := nil; (* just to be safe *)
topDLine := topDline + k;
firstDline := pfrom - topDline + 1;
end
else k := 0;
if j <> 0 then (* j=0 when display size increases *)
if smartTerminal and (j < dispHeight) then
begin
delLine(1,j); (* delete first j lines *)
insLine(dispHeight-j+1,j); (* insert j new lines at bottom *)
for i := oldDline+dispHeight-k to botDline-topDline+1 do
with lines[i]↑ do (* & add other lines *)
out1Line(i-firstDline+1,start,length);
end
else
for i := 1 to botDline-pfrom+1 do (* redraw top lines *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
firstLine := botDline + 1;
lastLine := pto;
botDLine := pto;
end;
end
else if (topDline <= pto) and (pto <= botDline) then
begin (* scroll down & add new top lines *)
k := botDline - pfrom + 1 - maxLines; (* # of lines needed *)
if k > 0 then botDLine := botDline - k;
k := topDline - pfrom; (* amount to shift down *)
for i := maxLines-k+1 to maxLines do relLine(lines[i]); (* flush old lines *)
for i := maxLines downto k+1 do lines[i] := lines[i-k]; (* shift down others *)
for i := 1 to k do lines[i] := nil; (* just to be safe *)
firstDline := 1;
j := pto - topDline - oldDline + 2; (* # lines kept on display *)
if smartTerminal and (j > 0) then
begin
delLine(j+1,dispHeight-j); (* delete all but first j lines *)
insLine(1,dispHeight-j); (* & move them to bottom *)
for i := topDline-pfrom+1 to topDline+oldDline-pfrom do
with lines[i]↑ do (* & add other lines *)
out1Line(i,start,length);
end
else
for i := topDline-pfrom+1 to dispHeight do
with lines[i]↑ do (* redraw bottom lines *)
out1Line(i,start,length);
firstLine := pfrom;
lastLine := topDline - 1;
topDLine := pfrom;
end
else
begin (* need to redo entire display *)
for i := 1 to maxLines do
if lines[i] <> nil then
begin
relLine(lines[i]); (* release old lines *)
lines[i] := nil;
end;
firstLine := pfrom;
lastLine := pto;
topDLine := pfrom; (* re-draw entire display *)
botDLine := pto;
firstDline := 1;
end;
borderLines;
curLine := 0;
if firstLine <= lastLine then
e2cPutStmnt(dProg,0,99); (* write & display new lines *)
if setCursor then
begin
if (cursorLine < firstLine) or (lastLine < cursorLine) then
begin
firstLine := cursorLine;
lastLine := cursorLine;
dontPrint := true;
curLine := 0;
e2cPutStmnt(dProg,0,99); (* use putStmnt to set cursor *)
dontPrint := false;
end;
setCursor := false;
setECurInt; (* figure out what process we're pointing at *)
end;
end;
(* routines to shift display: deleteLines, insertLines *)
procedure deleteLines(start,number,coff: integer); external;
procedure deleteLines;
var i,j,k,dHp,odHp: integer; p: pdbp;
begin
odHp := dprog↑.nlines;
if sParse then j := sCursor else j := 1;
for i := j to cursor - coff do (* update cursor stack *)
with cursorStack[i] do
if stmntp then st↑.nlines := st↑.nlines - number;
if not sParse then
begin
if dispHeight < odHp then odHp := dispHeight;
i := 1;
while (i <= nmarks) and (marks[i] <= cursorLine) do i := i + 1;
while (i <= nmarks) and (marks[i] <= cursorLine + number) do
if i > 1 then
if marks[i-1] = cursorLine then
begin (* delete extra mark *)
nmarks := nmarks - 1;
for j := i to nmarks do marks[j] := marks[j+1];
end
else begin marks[i] := cursorLine; i := i + 1 end
else begin marks[i] := cursorLine; i := i + 1 end;
for j := i to nmarks do marks[j] := marks[j] - number;
for i := 0 to debugLevel do
begin
if i = 0 then p := allPdbs else p := debugPdbs[i];
while p <> nil do
with p↑ do
begin
if linenum >= cursorLine then
if linenum >= cursorLine + number then linenum := cursorLine
else linenum := linenum - number;
p := nextPdb;
end;
end;
if pcline >= cursorLine then
if pcline >= cursorLine + number then pcline := cursorLine
else pcline := pcline - number;
end;
if not fParse then
begin
if start < topDline then
begin
number := number - (topDline - start);
start := topDline;
end;
if start + number - 1 > botDline then
number := botDline - start + 1;
j := start - topDline + 1;
for i := j to j + number - 1 do (* make sure deleted lines are released *)
relLine(lines[i]);
for i := j + number to botDline - topDLine + 1 do (* roll up *)
lines[i-number] := lines[i];
botDline := botDline - number;
for i := botDline - topDline + 2 to maxLines do lines[i] := nil;
dHp := dprog↑.nlines;
if dispHeight < dHp then dHp := dispHeight;
if start + number < topDline + firstDline then
firstDline := firstDline - number (* screen ok as is *)
else if start <= topDline + firstDline + dHp - 2 then
begin (* need to shift new lines onto screen *)
j := topDline + firstDline + dispHeight - 2 - dprog↑.nlines;
if j > 0 then (* j = # lines to add at top *)
begin (* at bottom - need to shift top down *)
if topDline + firstDline - 1 <= j then (* program length < display height *)
j := topDline + firstDline - 2; (* max # lines can add at top *)
if j > 0 then
begin (* first roll down *)
if j >= firstDline then
begin (* need to make space at top of buffer *)
k := j - firstDline + 1; (* number of new lines to add *)
for i := maxLines downto k+1 do lines[i] := lines[i-k];
for i := 1 to k do lines[i] := nil;
topDline := topDline - k;
firstDline := 1;
end
else
begin
firstDline := firstDline - j;
k := 0;
end;
number := number - j;
if smartTerminal then
begin
delLine(start-(topDline+k+firstDline-2),number+j); (* delete the lines *)
insLine(1,j); (* & insert some more at top *)
insLine(dHp-number+1,number); (* & at bottom too *)
end
else
for i := j + 1 to odHp - number do (* redraw top lines *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
for i := k+1 to j do
with lines[firstDline+i-1]↑ do
out1Line(i,start,length); (* redraw lines already in buffer *)
firstLine := topDline;
lastLine := topDline + k - 1;
curLine := 0;
if firstLine <= lastLine then
e2cPutStmnt(dProg,0,99); (* write & display new lines *)
start := start + j; (* correct for below *)
end;
end
else j := 0;
if number > 0 then
begin
if j <= 0 then (* make sure roll up above didn't already shift display *)
begin
j := start - (topDline + firstDline - 2);
if smartTerminal then
begin
delLine(j,number); (* delete some lines *)
insLine(dispHeight-number+1,number); (* & insert some more at bottom *)
end
else
for i := j to odHp - number do (* redraw middle lines *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
end;
for i := odHp - number to dHp do
if lines[firstDline+i-1] <> nil then (* already in buffer *)
with lines[firstDline+i-1]↑ do
out1Line(i,start,length); (* redraw it *)
firstLine := botDline + 1;
lastLine := topDline + firstDline + dHp - 2;
botDline := lastLine;
curLine := 0;
if firstLine <= lastLine then
e2cPutStmnt(dProg,0,99); (* write & display new lines *)
end;
if odHp < dispHeight then odHp := odHp + 1;
for i := dHp+1 to odHp do clearLine(i); (* flush any unused lines *)
end;
borderLines;
end;
end;
procedure insertLines(start,number,coff: integer); external; (* this one's easy *)
procedure insertLines;
var i,j: integer; p: pdbp;
begin
if sParse then j := sCursor else j := 1;
if coff >= 0 then
for i := j to cursor - coff do (* update cursor stack *)
with cursorStack[i] do
if stmntp then st↑.nlines := st↑.nlines + number;
if not sParse then
begin
for i := 1 to nmarks do (* update mark table *)
if marks[i] >= cursorLine then marks[i] := marks[i] + number;
for i := 0 to debugLevel do
begin
if i = 0 then p := allPdbs else p := debugPdbs[i];
while p <> nil do
with p↑ do
begin
if linenum >= cursorLine then linenum := linenum + number;
p := nextPdb;
end;
end;
if pcline >= cursorLine then pcline := pcline + number;
end;
if not fParse then
begin
if start < topDline then
begin
number := number - (topDline - start);
start := topDline;
end;
if start + number > topDline + maxLines - 2 then
number := topDline + maxLines - start;
if firstDline + dispHeight - 1 + number > maxLines then
begin (* need to roll lines array up some *)
for i := 1 to number do relLine(lines[i]); (* flush top lines *)
for i := 1 to maxLines - number do lines[i] := lines[i+number]; (* roll up *)
for i := maxLines-number+1 to maxLines do lines[i] := nil;
topDline := topDline + number;
firstDline := firstDline - number;
botDline := botDline - number;
end;
for i := maxLines-number+1 to maxLines do relLine(lines[i]); (* flush buffer bottom *)
for i := maxLines - number downto start - topDline + 1 do
lines[i+number] := lines[i]; (* shift buffer down *)
for i := start - topDline + 1 to start - topDline + number do
lines[i] := nil;
botDline := botDline + number;
if botDline >= topDline + maxLines then botDline := topDline + maxLines - 1;
if start < topDline + firstDline - 1 then
firstDline := firstDline + number
else if start <= topDline + firstDline + dispHeight - 2 then
begin (* some of the insert is on screen, so adjust it *)
if topDline + firstDline + dispHeight - 1 < start + number then
begin
number := topDline + firstDline + dispHeight - 2 - start;
end;
j := start - (topDline + firstDline - 2); (* screen line to insert at *)
if smartTerminal then
begin
delLine(dispHeight-number+1,number); (* delete some lines at bottom *)
insLine(j,number); (* & insert more in middle *)
end
else
begin
for i := j to j + number - 1 do clearLine(i); (* clear inserted lines *)
for i := j + number to dispHeight do (* redraw bottom lines *)
if lines[firstDline+i-1] <> nil then
with lines[firstDline+i-1]↑ do
out1Line(i,start,length);
end;
end;
borderLines;
end;
end;